home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 008 / moire.bas < prev    next >
BASIC Source File  |  1985-10-09  |  8KB  |  173 lines
  1. 10 ' **********************************************************************
  2. 20 ' **                       MOIRE.BAS                                  **
  3. 30 ' ** Adapted From: Listing 3, Getting Moire From Your Computer.       **
  4. 40 ' **               February, 1984                                     **
  5. 50 ' **               Creative Computing - Mark Gardner                  **
  6. 60 ' ** This Version: Michael L. Connell                                 **
  7. 70 ' **               3050 1/2 East, 2225 South                          **
  8. 80 ' **               Salt Lake City, Utah 84109                         **
  9. 90 '**********************************************************************
  10. 100 CLS:KEY OFF:LOCATE 10,35:PRINT"More Moire:":LOCATE 11,24:PRINT"A program for pattern generation.":LOCATE 12,14:PRINT"Do you want background information and instructions?"
  11. 110 A$=INKEY$:IF A$="" THEN 110
  12. 120 IF A$ <>"n" AND A$ <> "N" AND A$<>"y" AND A$<>"Y" THEN 110
  13. 130 IF A$ ="n" OR A$ = "N"  THEN 160
  14. 140 GOSUB 1210
  15. 150 '********* INPUT OF PARAMETERS FOR PATTERN GENERATION *********
  16. 160 CLS:INPUT"Enter a number from 1 to 39: ";O1:INPUT"Enter a number from 1 to 30: ";O2
  17. 170 PRINT:PRINT"Select one:":PRINT"     1 - X*X and Y*Y":PRINT"     2 - X*Y and Y*Y":PRINT"     3 - X*Y and Y*X":PRINT"     4 - X*X and Y*X"
  18. 180 A$=INKEY$:IF A$="" THEN 180
  19. 190 IF A$ <> "1" AND A$ <> "2" AND A$<>"3" AND A$<>"4" THEN 180
  20. 200 PRINT"You have selected ";A$;"."
  21. 210 PRINT:PRINT"Select one:":PRINT"     1 - O1 and O1":PRINT"     2 - O1 and O2"
  22. 220 G$=INKEY$:IF G$="" THEN 220
  23. 230 IF G$ <> "1" AND G$ <> "2" THEN 220
  24. 240 PRINT"You have selected ";G$;"."
  25. 250 PRINT:PRINT"Select equation type:":PRINT"     1 - Square Root":PRINT"     2 - Sin":PRINT"     3 - Cos"
  26. 260 X$=INKEY$:IF X$="" THEN 260
  27. 270 IF X$ <> "1" AND X$ <> "2" AND X$<>"3" THEN 260
  28. 280 PRINT"You have selected ";X$;"."
  29. 290 '********* THIS PAUSE IS SO THAT THE PARMS MAY BE RECORDED *********
  30. 300 '********* I USE THE NOTEPAD FROM SIDEKICK WHICH DOES WELL *********
  31. 310 PRINT"Press <SPACE> to continue.."
  32. 320 B$=INKEY$:IF B$<>" " THEN 320
  33. 330 '********* SET UP COUNTER SO PROGRESS MAY BE MONITORED *********
  34. 340 CLS:LOCATE 9,32:PRINT"I";:LOCATE 9,37:PRINT"J";:LOCATE 10,31:PRINT"62";
  35. 350 LOCATE 8,19:PRINT"Countdown to Pattern Completion":LOCATE 20,1
  36. 360 '********* GENERATE PATTERN ACCORDING TO THE PARMS SELECTED *********
  37. 370 DIM PRINTARRAY(79,63)
  38. 380 DATA 12,62,17,84,21,85,25,23,28,21,30,9,33,38,35,68,37,85,39,89
  39. 390 B=10
  40. 400 FOR I=1 TO 62:FOR J=1 TO 78
  41. 410 IF G$="2" THEN GOTO 440
  42. 420 XC1=J-O1+B:YC1=I-O2
  43. 430 XC2=J-O2:YC2=I-O1-B:GOTO 460
  44. 440 XC1=J-O1+B:YC1=I-O2
  45. 450 XC2=J-O1:YC2=I-O2-B
  46. 460 YC1=YC1*1.6666:YC2=YC2*1.6666
  47. 470 IF X$="2" OR X$="3" THEN GOSUB 1560:GOTO 560
  48. 480 IF A$="2" THEN 520
  49. 490 IF A$="3" THEN 530
  50. 500 IF A$="4" THEN 540
  51. 510 RC1=SQR(XC1*XC1+YC1*YC1):RC2=SQR(XC2*XC2+YC2*YC2):GOTO 550
  52. 520 RC1=SQR(ABS(XC1*YC1+YC1*YC1)):RC2=SQR(ABS(XC2*XC2+YC2*YC2)):GOTO 550
  53. 530 RC1=SQR(ABS(XC1*YC1+XC1*YC1)):RC2=SQR(ABS(RC2*XC2+YC2*YC2)):GOTO 550
  54. 540 RC1=SQR(ABS(XC1*XC1+XC1*YC1)):RC2=SQR(ABS(XC2*XC2+YC2*YC2))
  55. 550 RESTORE
  56. 560 FOR K = 1 TO 10
  57. 570 READ RNEXT
  58. 580 IF RNEXT<RC1 THEN 620
  59. 590 IF K MOD 2 = 1 THEN INSERT = 1 ELSE INSERT = 4
  60. 600 PRINTARRAY(J,I)=INSERT
  61. 610 K=11
  62. 620 NEXT K
  63. 630 RESTORE
  64. 640 FOR K = 1 TO 10
  65. 650 READ RNEXT
  66. 660 IF RNEXT<RC2 THEN 700
  67. 670 IF K MOD 2 = 1 THEN INSERT=2 ELSE INSERT=8
  68. 680 PRINTARRAY(J,I)=PRINTARRAY(J,I)+INSERT
  69. 690 K=11
  70. 700 NEXT K
  71. 710 LOCATE 10,35:PRINT 78-J:NEXT J:LOCATE 10,30:PRINT 62-I:NEXT I
  72. 720 '********* ALERT USER THAT PATTERN IS READY TO DISPLAY *********
  73. 730 BEEP:BEEP:BEEP
  74. 740 '********* WAIT UNTIL READY *********
  75. 750 PRINT"Ready to display pattern?"
  76. 760 P$=INKEY$:IF P$<>"Y" AND P$<>"y" THEN 760
  77. 770 '******** DISPLAY PATTERN ON CRT *********
  78. 780 FOR I=0 TO 63
  79. 790 FOR J=1 TO 78
  80. 800 AR=PRINTARRAY(J,I)
  81. 810 IF AR=0 THEN PRINT" ";:GOTO 910
  82. 820 IF AR=4 THEN PRINT" ";:GOTO 910
  83. 830 IF AR=8 THEN PRINT" ";:GOTO 910
  84. 840 IF AR=3 THEN PRINT"H";:GOTO 910
  85. 850 IF AR=12 THEN PRINT"H";:GOTO 910
  86. 860 IF AR+PRINTARRAY(J+1,I)=3 THEN PRINT "]";:GOTO 910
  87. 870 IF AR+PRINTARRAY(J-1,I)=3 THEN PRINT "[";:GOTO 910
  88. 880 IF AR+PRINTARRAY(J+1,I)=12 THEN PRINT "]";:GOTO 910
  89. 890 IF AR+PRINTARRAY(J-1,I)=12 THEN PRINT "[";:GOTO 910
  90. 900 PRINT ".";
  91. 910 NEXT J
  92. 920 PRINT
  93. 930 NEXT I
  94. 940 '********* CHECK FOR HARDOCOPY REQUESTS *********
  95. 950 PRINT"Do you want hardcopy of this pattern?"
  96. 960 H$=INKEY$:IF H$="" THEN 960
  97. 970 '********* CHECK FOR RUNNING OF PROGRAM AGAIN *********
  98. 980 IF H$="y" OR H$="Y" THEN GOSUB 1040
  99. 990 PRINT"Try again?"
  100. 1000 C$=INKEY$:IF C$="" THEN 1000
  101. 1010 IF C$="y" OR C$="Y" THEN RUN
  102. 1020 CLS:PRINT"I hope that this program has brought you some enjoyment.":END
  103. 1030 '********** HARDCORY SUBROUTINE ********
  104. 1040 FOR I=0 TO 63
  105. 1050 FOR J=1 TO 78
  106. 1060 AR=PRINTARRAY(J,I)
  107. 1070 IF AR=0 THEN LPRINT" ";:GOTO 1170
  108. 1080 IF AR=4 THEN LPRINT" ";:GOTO 1170
  109. 1090 IF AR=8 THEN LPRINT" ";:GOTO 1170
  110. 1100 IF AR=3 THEN LPRINT"H";:GOTO 1170
  111. 1110 IF AR=12 THEN LPRINT"H";:GOTO 1170
  112. 1120 IF AR+PRINTARRAY(J+1,I)=3 THEN LPRINT "]";:GOTO 1170
  113. 1130 IF AR+PRINTARRAY(J-1,I)=3 THEN LPRINT "[";:GOTO 1170
  114. 1140 IF AR+PRINTARRAY(J+1,I)=12 THEN LPRINT "]";:GOTO 1170
  115. 1150 IF AR+PRINTARRAY(J-1,I)=12 THEN LPRINT "[";:GOTO 1170
  116. 1160 LPRINT ".";
  117. 1170 NEXT J
  118. 1180 LPRINT
  119. 1190 NEXT I:RETURN
  120. 1200 '********* INSTRUCTIONS SUBROUTINE ********
  121. 1210 CLS
  122. 1220 LOCATE 5,35:PRINT"More Moire.":LOCATE 8,1
  123. 1230 PRINT"     In the February, 1984 edition of Creative Computing Mark Gardner "
  124. 1240 PRINT"presented a short program for generating moire patterns which could be used"
  125. 1250 PRINT"without either a graphics printer, or graphics commands.  I experimented   "
  126. 1260 PRINT"with utilizing different input types and soon found that in addition to the"
  127. 1270 PRINT"creation of moire patterns I could make many other different designs quite "
  128. 1280 PRINT"simply."
  129. 1290 PRINT
  130. 1300 PRINT
  131. 1310 PRINT"     This program began as a user interface to make the selection of    "
  132. 1320 PRINT"parameters easier.  It developed into non-moire pattern types, and allows  "
  133. 1330 PRINT"flexibility in display.                                                    "
  134. 1340 PRINT:PRINT:PRINT"Press any key to continue...."
  135. 1350 A$=INKEY$:IF A$="" THEN 1350
  136. 1360 CLS:LOCATE 5,35:PRINT"More Moire.":LOCATE 8,1
  137. 1370 PRINT"     The user is requested to enter parameters which effect the pattern    "
  138. 1380 PRINT"being generated.  The first of these, O1 and O2, are used to determine the "
  139. 1390 PRINT"offset from the center.  The user is then given the oportunity to select   "
  140. 1400 PRINT"various options dealing with the equations used to generate the pattern.   "
  141. 1410 PRINT
  142. 1420 PRINT
  143. 1430 PRINT"     The pattern is then generated according to the determined options.    "                                                                           "
  144. 1440 PRINT"Once generated the user is prompted and the pattern may be displayed.      "
  145. 1450 PRINT"Display is first to the CRT and then to the printer, if desired.  With     "
  146. 1460 PRINT"experience many interesting and pleasing designs may be created.        "
  147. 1470 PRINT"
  148. 1480 PRINT
  149. 1490 PRINT
  150. 1500 PRINT"     The program is slow, so be warned, listen for the bell, and enjoy!!   "
  151. 1510 PRINT"     Press any key to begin.  {<ESC> will exit the program at this point.}"
  152. 1520 A$=INKEY$:IF A$="" THEN 1520
  153. 1530 IF A$=CHR$(27) THEN CLS:PRINT"Sorry you didn't try the program, maybe another time!":PRINT:PRINT:PRINT:END
  154. 1540 RETURN
  155. 1550 '********* Sin and Cosine Equation Options *********
  156. 1560 IF X$="3" GOTO 1650
  157. 1570 IF A$="2" THEN 1610
  158. 1580 IF A$="3" THEN 1620
  159. 1590 IF A$="4" THEN 1630
  160. 1600 RC1=10*SIN(XC1*XC1+YC1*YC1):RC2=10*SIN(XC2*XC2+YC2*YC2):GOTO 1640
  161. 1610 RC1=10*SIN(ABS(XC1*YC1+YC1*YC1)):RC2=10*SIN(ABS(XC2*XC2+YC2*YC2)):GOTO 1640
  162. 1620 RC1=10*SIN(ABS(XC1*YC1+XC1*YC1)):RC2=10*SIN(ABS(RC2*XC2+YC2*YC2)):GOTO 1640
  163. 1630 RC1=10*SIN(ABS(XC1*XC1+XC1*YC1)):RC2=10*SIN(ABS(XC2*XC2+YC2*YC2))
  164. 1640 RESTORE :RETURN
  165. 1650 IF A$="2" THEN 1690
  166. 1660 IF A$="3" THEN 1700
  167. 1670 IF A$="4" THEN 1710
  168. 1680 RC1=10*COS(XC1*XC1+YC1*YC1):RC2=10*COS(XC2*XC2+YC2*YC2):GOTO 1720
  169. 1690 RC1=10*COS(ABS(XC1*YC1+YC1*YC1)):RC2=10*COS(ABS(XC2*XC2+YC2*YC2)):GOTO 1720
  170. 1700 RC1=10*COS(ABS(XC1*YC1+XC1*YC1)):RC2=10*COS(ABS(RC2*XC2+YC2*YC2)):GOTO 1720
  171. 1710 RC1=16*COS(ABS(XC1*XC1+XC1*YC1)):RC2=16*COS(ABS(XC2*XC2+YC2*YC2))
  172. 1720 RESTORE :RETURN
  173.